home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
glyfview
/
unit1.pas
< prev
Wrap
Pascal/Delphi Source File
|
1995-12-22
|
3KB
|
137 lines
unit Unit1;
(*
Just a quick ditty for diplaying a directory of bitmaps that may be
used as glyphs. Still needs a Print button. Excuse the style - not
originally intended for anyone else. Ought to be fixed up for
use on Tools palette, with automatic redraw as choices are changed.
Enjoy.
Jay Baker
CIS 73530,3146
*)
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, FileCtrl, StdCtrls, ExtCtrls, Buttons;
type
TForm1 = class(TForm)
Panel1: TPanel;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
rg1: TRadioGroup;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
rg2: TRadioGroup;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FileListBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
MaxBmpHeight=20;
procedure TForm1.Button1Click(Sender: TObject);
procedure disp(Canvas:TCanvas);
var
i:integer;
b:TBitMap;
drect,srect:TRect;
z,x,y:integer;
s:string;
yText:integer;
dx,dy:integer;
ncols:integer;
nrows:integer;
i1,i2:integer;
bs:integer;
begin
with Canvas do begin Brush.Color:=clSilver; FillRect(ClipRect) end;
yText:=abs(Canvas.Font.Height)+2;
dx:=MaxBmpHeight+36;
dy:=MaxBmpHeight+yText+8;
with ClientRect do ncols:=(Right-Left) div dx;
nrows:=(Panel1.Top-8) div dy;
bs:=rg1.ItemIndex;
b:=TBitmap.Create; try
i1:=rg2.ItemIndex*(nrows*ncols);
i2:=i1+(nrows*ncols);
with FileListBox1.Items do if i2>Count then i2:=Count;
for i:=i1 to i2-1 do begin
Application.ProcessMessages;
x:=4+dx*((i-i1) mod ncols);
y:=4+dy*((i-i1) div ncols);
Canvas.Rectangle(x,y,x+dx+1,y+dy+1);
s:=FileListBox1.Items[i];
b.LoadFromFile(s);
(*
if i in [1..3] then with b do
if Width <> (Width div Height) * Height then
MessageDlg('w='+IntToStr(Width)+',h='+IntToStr(Height),
mtInformation,[mbOK],0);
*)
system.Delete(s,length(s)-3,4);
Canvas.TextOut(x+4,y+2,s);
case bs of
0..3:begin
drect:=Rect(x+4,y+4+yText,x+4+b.Height,y+4+yText+b.Height);
srect:=Rect(bs*b.Height,0,(bs+1)*b.Height,b.Height);
end;
4 :begin
drect:=Rect(x+4,y+4+yText,x+4+b.Width,y+4+yText+b.Height);
srect:=Rect(0,0,b.Width,b.Height);
end;
end;
Canvas.BrushCopy(drect,b,srect,b.TransparentColor);
end;
finally b.Free end;
end;
begin
disp(Canvas);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close
end;
procedure TForm1.FileListBox1Change(Sender: TObject);
var
yText,dx,dy,ncols:integer;
nrows:integer;
i:integer;
begin
rg2.Items.Clear;
rg2.Enabled:=false;
if FileListBox1.Items.Count=0 then exit;
yText:=abs(Canvas.Font.Height)+2;
dx:=MaxBmpHeight+36;
dy:=MaxBmpHeight+yText+8;
with ClientRect do ncols:=(Right-Left) div dx;
nrows:=(Panel1.Top-8) div dy;
for i:=1 to (FileListBox1.Items.Count+(ncols*nrows)-1) div (ncols*nrows) do
rg2.Items.Add(IntToStr(i));
rg2.ItemIndex:=0;
rg2.Enabled:=rg2.Items.Count>1;
end;
end.